home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / File / DosGlob.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  4.3 KB  |  174 lines
  1.  
  2.  
  3. package File::DosGlob;
  4.  
  5. unless (caller) {
  6.     $| = 1;
  7.     while (@ARGV) {
  8.     my $arg = shift;
  9.     my @m = doglob(1,$arg);
  10.     print (@m ? join("\0", sort @m) : $arg);
  11.     print "\0" if @ARGV;
  12.     }
  13. }
  14.  
  15. sub doglob {
  16.     my $cond = shift;
  17.     my @retval = ();
  18.   OUTER:
  19.     for my $arg (@_) {
  20.         local $_ = $arg;
  21.     my @matched = ();
  22.     my @globdirs = ();
  23.     my $head = '.';
  24.     my $sepchr = '/';
  25.     next OUTER unless defined $_ and $_ ne '';
  26.     if (/^"(.*)"$/) {
  27.         $_ = $1;
  28.         if ($cond eq 'd') { push(@retval, $_) if -d $_ }
  29.         else              { push(@retval, $_) if -e $_ }
  30.         next OUTER;
  31.     }
  32.     if (m|^(.*)([\\/])([^\\/]*)$|) {
  33.         my $tail;
  34.         ($head, $sepchr, $tail) = ($1,$2,$3);
  35.         push (@retval, $_), next OUTER if $tail eq '';
  36.         if ($head =~ /[*?]/) {
  37.         @globdirs = doglob('d', $head);
  38.         push(@retval, doglob($cond, map {"$_$sepchr$tail"} @globdirs)),
  39.             next OUTER if @globdirs;
  40.         }
  41.         $head .= $sepchr if $head eq '' or $head =~ /^[A-Za-z]:$/;
  42.         $_ = $tail;
  43.     }
  44.     unless (/[*?]/) {
  45.         $head = '' if $head eq '.';
  46.         $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
  47.         $head .= $_;
  48.         if ($cond eq 'd') { push(@retval,$head) if -d $head }
  49.         else              { push(@retval,$head) if -e $head }
  50.         next OUTER;
  51.     }
  52.     opendir(D, $head) or next OUTER;
  53.     my @leaves = readdir D;
  54.     closedir D;
  55.     $head = '' if $head eq '.';
  56.     $head .= $sepchr unless $head eq '' or substr($head,-1) eq $sepchr;
  57.  
  58.     s:([].+^\-\${}[|]):\\$1:g;
  59.     s/\*/.*/g;
  60.     s/\?/.?/g;
  61.  
  62.     my $matchsub = eval 'sub { $_[0] =~ m|^' . $_ . '$|io }';
  63.     warn($@), next OUTER if $@;
  64.       INNER:
  65.     for my $e (@leaves) {
  66.         next INNER if $e eq '.' or $e eq '..';
  67.         next INNER if $cond eq 'd' and ! -d "$head$e";
  68.         push(@matched, "$head$e"), next INNER if &$matchsub($e);
  69.         if (index($e,'.') == -1 and length($e) < 9
  70.             and index($_,'\\.') != -1) {
  71.         push(@matched, "$head$e"), next INNER if &$matchsub("$e.");
  72.         }
  73.     }
  74.     push @retval, @matched if @matched;
  75.     }
  76.     return @retval;
  77. }
  78.  
  79. sub glob { doglob(1,@_) }
  80.  
  81. sub import {
  82.     my $pkg = shift;
  83.     my $callpkg = caller(0);
  84.     my $sym = shift;
  85.     *{$callpkg.'::'.$sym} = \&{$pkg.'::'.$sym} if $sym eq 'glob';
  86. }
  87.  
  88. 1;
  89.  
  90. __END__
  91.  
  92. =head1 NAME
  93.  
  94. File::DosGlob - DOS like globbing and then some
  95.  
  96. perlglob.bat - a more capable perlglob.exe replacement
  97.  
  98. =head1 SYNOPSIS
  99.  
  100.     require 5.004;
  101.     use File::DosGlob 'glob';  # override CORE::glob
  102.     @perlfiles = glob  "..\\pe?l/*.p?";
  103.     print <..\\pe?l/*.p?>;
  104.     
  105.     > perl -MFile::DosGlob=glob -e "print <../pe*/*p?>"
  106.     
  107.     > perlglob ../pe*/*p?
  108.  
  109. =head1 DESCRIPTION
  110.  
  111. A module that implements DOS-like globbing with a few enhancements.
  112. This file is also a portable replacement for perlglob.exe.  It
  113. is largely compatible with perlglob.exe (the M$ setargv.obj
  114. version) in all but one respect--it understands wildcards in
  115. directory components.
  116.  
  117. For example, C<<..\\l*b\\file/*glob.p?>> will work as expected (in
  118. that it will find something like '..\lib\File/DosGlob.pm' alright).
  119. Note that all path components are case-insensitive, and that
  120. backslashes and forward slashes are both accepted, and preserved.
  121. You may have to double the backslashes if you are putting them in
  122. literally, due to double-quotish parsing of the pattern by perl.
  123.  
  124. When invoked as a program, it will print null-separated filenames
  125. to standard output.
  126.  
  127. While one may replace perlglob.exe with this, usage by overriding
  128. CORE::glob via importation should be much more efficient, because
  129. it avoids launching a separate process, and is therefore strongly
  130. recommended.
  131.  
  132. Extending it to csh patterns is left as an exercise to the reader.
  133.  
  134. =head1 EXPORTS (by request only)
  135.  
  136. glob()
  137.  
  138. =head1 BUGS
  139.  
  140. Should probably be built into the core, and needs to stop
  141. pandering to DOS habits.  Needs a dose of optimizium too.
  142.  
  143. =head1 AUTHOR
  144.  
  145. Gurusamy Sarathy <gsar@umich.edu>
  146.  
  147. =head1 HISTORY
  148.  
  149. =over 4
  150.  
  151. =item *
  152.  
  153. A few dir-vs-file optimizations result in glob importation being
  154. 10 times faster than using perlglob.exe, and using perlglob.bat is
  155. only twice as slow as perlglob.exe (GSAR 28-MAY-97)
  156.  
  157. =item *
  158.  
  159. Several cleanups prompted by lack of compatible perlglob.exe
  160. under Borland (GSAR 27-MAY-97)
  161.  
  162. =item *
  163.  
  164. Initial version (GSAR 20-FEB-97)
  165.  
  166. =back
  167.  
  168. =head1 SEE ALSO
  169.  
  170. perl
  171.  
  172. =cut
  173.  
  174.